home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PAS_0793 / VSCREEN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-08-01  |  28KB  |  745 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 246 of 278                                                               
  3. From : Liam Stitt                          1:134/21.0           14 Jul 93  11:51 
  4. To   : Digant Kasundra                                                           
  5. Subj : virtual screens                                                        
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Live Long and Prosper, Digant! On 07-13-93  07:15 you scribbled about Re:
  8. virtual screens
  9.  
  10.  DK> It's a  214 area code call.  How can you send it to me.  Can you like,
  11.  DK> attach it to a  message to me or something.  I'm new of this concept of
  12.  DK> "NetMail".  But I  would like this program.  Try and write back.
  13.  
  14.  This is part one...
  15.  
  16. ___VScreen.PAS: interface---}
  17.  
  18. unit VScreen;
  19.  
  20. (* I don't know who originally wrote this.  I found it on a local Pascal   *)
  21. (* programming BBS.  If the real author reads this, would you stand up and *)
  22. (* let us know who you are?                                                *)
  23.  
  24. (* All I did was add the proc and func listing, clean up the code - in     *)
  25. (* other words, convert it to my style.                                    *)
  26.  
  27. interface
  28.  
  29. {$F+}                           (* allow it to be overlaid *)
  30.  
  31. const
  32.   Rows = 25;                    (* Change for EGA 43x80 or VGA 50x80 modes *)
  33.   Columns = 80;
  34.   VsWordSize = Rows * Columns;
  35.   VsByteSize = Rows * Columns * 2;
  36.  
  37. type
  38.   FnString = String[12];        (* FileName string size *)
  39.   VsPtr = ^VirtualScreenArray;  (* Virtual-screen pointer type *)
  40.   VirtualScreenArray = Array[1..VsWordSize] of Word;
  41.   XString = String[Columns];    (* XAxis length string-type *)
  42.   YString = String[Rows];     (* Yaxis length string-type *)
  43.   ScrollTypes = (Up, Down, Left, Right, FlipY, FlipX);
  44.  
  45. var
  46.   MainScreen: VsPtr;
  47.   ColorMode:  Boolean;
  48.  
  49. (* PUBLIC functions and procedures... *)
  50.  
  51. (* p VsInit(var VsPointer: VsPtr); - initializes VScreen pointer on heap   *)
  52.  
  53. (* p ReInitVsUnit; - reinitializes VScreen Unit                             *)
  54.  
  55. (* p ClrVScr(VsPointer: VsPtr; CAttr: Byte); - clear a VScreen w/color attr *)
  56.  
  57. (* p ClrVScrWindow(VsPointer: VsPtr; LxAxis, RxAxis, TopYaxis, BotYaxis,    *)
  58. (*   CAttr: Byte); - clears Window within a VScreen with color attribute    *)
  59.  
  60. (* p WriteIntVs(VsPointer: VsPtr; IntNum: LongInt; Width, Xaxis, Yaxis,     *)
  61. (*   CAttr: Byte); - writes Integer to a VScreen                            *)
  62.  
  63. (* p VWriteIntVs(VsPointer: VsPointer: VsPtr; IntNum: LongInt; Width,       *)
  64. (*   Xaxis, Yaxis, CAttr: Byte); - vertically writes Integer to a VScreen   *)
  65.  
  66. (* p WriteRealVs(VsPointer: VsPtr; RealNum: Real; Width, Decimals, Xaxis,   *)
  67. (*   Yaxis, CAttr: Byte); - writes Real to a VScreen                        *)
  68.  
  69. (* p VWriteRealVs(VsPointer: VsPtr; RealNum: Real; Width, Decimals, Xaxis,  *)
  70. (*   Yaxis, CAttr: Byte); - vertically writes Real to a VScreen             *)
  71.  
  72. (* p WriteStringVs(VsPointer: VsPtr; InString: XString; Wrap: Boolean       *)
  73. (*   Xaxis, Yaxis, CAttr: Byte); - writes a string to a VScreen. Quoting    *)
  74. (*   the author, "wrap defines whether a string will wrap around to the     *)
  75. (*   next line, it is not the bottom-line"                                  *)
  76.  
  77. (* p VWriteStringVs(VsPointer: VsPtr; InString: YString; Xaxis, Yaxis,      *)
  78. (*   CAttr: Byte); - vertically write string to VScreen                     *)
  79.  
  80. (* p SaveToVs(VsPointer: VsPtr); - saves the current screen to a VScreen    *)
  81.  
  82. (* p DisplayVs(VsPointer: VsPtr); - display a VScreen                       *)
  83.  
  84. (* p SetVsXYAttr(VsPointer: VsPtr; AttrsToChange, Xaxis, Yaxis,             *)
  85. (*   CAttr: Byte); Again quoting the author, "procedure to change           *)
  86. (*   AttrsToChange number of VScreen color attributes"                      *)
  87.  
  88. (* p VSetVsXYAttr(VsPointer: VsPtr; AttrsToChange, Xaxis, Yaxis,            *)
  89. (*   CAttr: Byte); - "procedure to vertically change AttrsToChange number   *)
  90. (*   of VScreen color attributes                                            *)
  91.  
  92. (* p SetVsWindowAttr(VsPointer: VsPtr; LxAxis, RxAxis, TopYaxis, BotYaxis,  *)
  93. (*   CAttr: Byte); - "procedure to change a window-block of VScreen color   *)
  94. (*   attributes"                                                            *)
  95.  
  96. (* p SetVsAttr(VsPointer: VsPtr; CAttr: Byte); - sets the color attribute   *)
  97. (*   for the entire VScreen                                                 *)
  98.  
  99. (* p SaveVsToDisk(VsPointer: VsPtr; FileName: FnString;                     *)
  100. (*   ScreenNumber: Word); - saves a VScreen to a disk file.  "ScreenNumber  *)
  101. (*   is the VScreen record number.                                          *)
  102.  
  103. (* p LoadVsFromDisk(VsPointer: VsPtr; FileName: FnString;                    *)
  104. (*   ScreenNumber: Word); - saves a VScreen to a disk file.  "ScreenNumber  *)
  105. (*   is the VScreen record number.                                          *)
  106.  
  107. (* f GetVsXYAttr(VsPointer: VsPtr; Xaxis, Yaxis: Byte): Byte; - function    *)
  108. (*   to return the attribute byte of a VScreen char at position X,Y         *)
  109.  
  110. (* f GetVsXYChar(VsPointer: VsPtr; Xaxis, Yaxis: Byte): Char; - function    *)
  111. (*   to return a character from position X,Y                                *)
  112.  
  113. (* f GetVsXYString(VsPointer: VsPtr; Xaxis, Yaxis,                          *)
  114. (*   StringSize: Byte): String; - returns StringSize text string from X,Y   *)
  115.  
  116. (* f VGetVsXYString(VsPointer: VsPtr; Xaxis, Yaxis,                         *)
  117. (*   StringSize: Byte): String; - returns vertical text string from X,Y     *)
  118.  
  119. (* p ScrollVs(VsPointer1: VsPtr; VsPointer2: VsPtr; Direction: ScrollTypes; *)
  120. (*   ScrollNum: Word); - procedure to scroll a VScreen by ScrollNum in any  *)
  121. (*   of the directions defined as ScrollType above; two other directions    *)
  122. (*   also available - FlipY, which reverses the order of the VScreen rows,  *)
  123. (*   and FlipX, which reverses the order of the VScreen columns, so that 1  *)
  124. (*   becomes 80 and so on.  "ScrollNum is ignored with these routines" -    *)
  125. (*   make whatever you can out of that, but it sounds to me like this proc  *)
  126. (*   isn't quite functioning properly.                                      *)
  127.  
  128. (* p MoveVsChar(VsPointer1: VsPtr; Xaxis1, Yaxis1: Byte; VsPointer2: VsPtr; *)
  129. (*   Xaxis2, Yaxis2: Byte); - moves character from X,Y to X,Y between       *)
  130. (*   VScreens                                                               *)
  131.  
  132. (* p MoveVsBlock(VsPointer1: VsPtr; Xaxis1, Yaxis1: Byte;                   *)
  133. (*   VsPointer2: VsPtr; Xaxis2, Yaxis2: Byte; CharsToMove: Word); - moves   *)
  134. (*   block of chars defined by CharsToMove from X,Y to X,Y between VScreens *)
  135.  
  136. (* p MoveVsWindowBlock(VsPointer1: VsPtr; LxAxis1, RxAxis1, TopYaxis1,      *)
  137. (*   BotYaxis1: Byte; VsPointer2: VsPtr; LxAxis2, RxAxis2, TopYaxis2,       *)
  138. (*   BotYaxis2: Byte); - moves "window block" from VScreen1 to VScreen2    *)
  139.  
  140.   procedure VsInit(var VsPointer: VsPtr);
  141.   procedure ReInitVsWrite;
  142.   procedure ClrVScr(VsPointer: VsPtr; CAttr: Byte);
  143.   procedure ClrVScrWindow(VsPointer: VsPtr; LxAxis, RxAxis, TopYaxis,
  144.                           BotYaxis, CAttr: Byte);
  145.   procedure WriteIntVs(VsPointer: VsPtr; IntNum: LongInt; Width, Xaxis,
  146.                        Yaxis, CAttr: Byte);
  147.   procedure VWriteIntVs(VsPointer: VsPtr; IntNum: LongInt; Width, Xaxis,
  148.                         Yaxis, CAttr: Byte);
  149.   procedure WriteRealVs(VsPointer: VsPtr; RealNum: Real; Width, Decimals,
  150.                         Xaxis, Yaxis, CAttr: Byte);
  151.   procedure VWriteRealVs(VsPointer: VsPtr; RealNum: Real; Width, Decimals,
  152.                          Xaxis, Yaxis, CAttr: Byte);
  153.   procedure WriteStringVs(VsPointer: VsPtr; InString: XString; Wrap: Boolean;
  154.                           Xaxis, Yaxis, CAttr: Byte);
  155.   procedure VWriteStringVs(VsPointer: VsPtr; InString: YString; Xaxis, Yaxis,
  156.                            CAttr: Byte);
  157.   procedure SaveToVs(VsPointer: VsPtr);
  158.   procedure DisplayVs(VsPointer: VsPtr);
  159.   procedure SetVsXYAttr(VsPointer: VsPtr; AttrsToChange, Xaxis, Yaxis,
  160.                         CAttr: Byte);
  161.   procedure VSetVsXYAttr(VsPointer: VsPtr; AttrsToChange, Xaxis, Yaxis,
  162.                          CAttr: Byte);
  163.   procedure SetVsWindowAttr(VsPointer: VsPtr; LxAxis, RxAxis, TopYaxis,
  164.                             BotYaxis, CAttr: Byte);
  165.   procedure SetVsAttr(VsPointer: VsPtr; CAttr: Byte);
  166.   procedure SaveVsToDisk(VsPointer: VsPtr; FileName: FnString;
  167.                         ScreenNumber: Word);
  168.   procedure LoadVsFromDisk(VsPointer: VsPtr; FileName: FnString;
  169.                            ScreenNumber: Word);
  170.   function GetVsXYAttr(VsPointer: VsPtr; Xaxis, Yaxis: Byte): Byte;
  171.   function GetVsXYchar(VsPointer: VsPtr; Xaxis, Yaxis: Byte): Char;
  172.   function GetVsXYString(VsPointer: VsPtr; Xaxis, Yaxis,
  173.                          StringSize: Byte): String;
  174.   function VGetVsXYString(VsPointer: VsPtr; Xaxis, Yaxis,
  175.                           StringSize: Byte): String;
  176.   procedure ScrollVs(VsPointer1: VsPtr; VsPointer2: VsPtr;
  177.                      Direction: ScrollTypes; ScrollNum: Word);
  178.   procedure MoveVsChar(VsPointer1: VsPtr; Xaxis1, Yaxis1: Byte;
  179.                        VsPointer2: VsPtr; Xaxis2, Yaxis2: Byte);
  180.   procedure MoveVsBlock(VsPointer1: VsPtr; Xaxis1, Yaxis1: Byte;
  181.                         VsPointer2: VsPtr; Xaxis2, Yaxis2: Byte;
  182.                         CharsToMove: Word);
  183.   procedure MoveVsWindowBlock(VsPointer1: VsPtr; LxAxis1, RxAxis1, TopYaxis1,
  184.                               BotYaxis1: Byte; VsPointer2: VsPtr; LxAxis2,
  185.                               RxAxis2, TopYaxis2, BotYaxis2: Byte);
  186.  
  187.  
  188. implementation
  189.  
  190. uses Crt;
  191.  
  192. var
  193.   VideoAddress: VsPtr;
  194.  
  195.   procedure VsInit(var VsPointer: VsPtr);
  196.   begin
  197.     if VsPointer = Nil then
  198.       begin
  199.         New(VsPointer);      (* Allocate Array on the Heap *)
  200.         FillChar(VsPointer^,SizeOf(VirtualScreenArray), 0)
  201.       end;
  202.   end;
  203.  
  204.   procedure ClrVScr(VsPointer: VsPtr; CAttr: Byte);
  205.   type
  206.     ClrArrayType = Array[1..(VsWordSize - 1)] of Word;
  207.   var
  208.     ClrPtr1, ClrPtr2: ^ClrArrayType;
  209.   begin
  210.     if VsPointer <> Nil then
  211.       begin
  212.         if CAttr = 0 then
  213.           FillChar(VsPointer^,VsByteSize, 0)
  214.         else
  215.           begin
  216.             ClrPtr1 := Addr(VsPointer^[1]); ClrPtr2 := Addr(VsPointer^[2]);
  217.             ClrPtr1^[1] := (32 + (CAttr shl 8)); ClrPtr2^ := ClrPtr1^;
  218.           end;
  219.       end;
  220.   end;
  221.  
  222.   procedure WriteIntVs(VsPointer: VsPtr; IntNum: LongInt; Width, Xaxis,
  223.                        Yaxis, CAttr: Byte);
  224.   const
  225.     TempString: XString = '';
  226.   var
  227.     TsIndex : Byte;
  228.     VsOffset: Word;
  229.   begin
  230.     if VsPointer <> Nil then
  231.       begin
  232.         if (Yaxis > Rows) then Yaxis := Rows;
  233.  
  234.         Str(IntNum:Width, TempString);
  235.  
  236.         if (Yaxis = Rows) and ((Length(TempString) + Xaxis) > Columns) then
  237.             TempString[0] := char((Columns + 1) - Xaxis);
  238.  
  239.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  240.  
  241.         for TsIndex := 0 to (Length(TempString) - 1) do
  242.           VsPointer^[VsOffset + TsIndex] :=
  243.                        (Byte(TempString[(TsIndex + 1)]) + (CAttr shl 8))
  244.       end;
  245.   end;
  246.  
  247.   procedure VWriteIntVs(VsPointer: VsPtr; IntNum: LongInt; Width, Xaxis,
  248.                         Yaxis, CAttr: Byte);
  249.   const
  250.     TempString: YString = '';
  251.   var
  252.     TSindex : Byte;
  253.     VsOffset: Word;
  254.   begin
  255.     if VsPointer <> Nil then
  256.       begin
  257.         if (Yaxis > Rows) then Yaxis := Rows;
  258.         if (Xaxis > Columns) then Xaxis := Columns;
  259.  
  260.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  261.         Str(IntNum:Width, TempString);
  262.  
  263.         if ((Length(TempString) + Yaxis) > Rows) then
  264.           TempString[0] := char((Rows + 1) - Yaxis);
  265.  
  266.         for TSindex := 0 to (Length(TempString) - 1) do
  267.           VsPointer^[VsOffset + (TSindex * Columns)] :=
  268.                        (Byte(TempString[(TSindex + 1)]) + (CAttr shl 8))
  269.       end;
  270.   end;
  271.  
  272.   procedure WriteRealVs(VsPointer: VsPtr; RealNum: Real; Width, Decimals,
  273.                         Xaxis, Yaxis, CAttr: Byte);
  274.   const
  275.     TempString: XString = '';
  276.   var
  277.     TsIndex : Byte;
  278.     VsOffset: Word;
  279.   begin
  280.     if VsPointer <> Nil then
  281.       begin
  282.         if (Yaxis > Rows) then Yaxis := Rows;
  283.  
  284.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  285.         Str(RealNum:Width:Decimals, TempString);
  286.  
  287.         if (Yaxis = Rows) and ((Length(TempString) + Xaxis) > Columns) then
  288.             TempString[0] := char((Columns + 1) - Xaxis);
  289.  
  290.         for TsIndex := 0 to (Length(TempString) - 1) do
  291.           VsPointer^[VsOffset + TsIndex] :=
  292.                        (Byte(TempString[(TsIndex + 1)]) + (CAttr shl 8))
  293.       end
  294.   end;
  295.  
  296.   procedure VWriteRealVs(VsPointer: VsPtr; RealNum: Real; Width, Decimals,
  297.                          Xaxis, Yaxis, CAttr: Byte);
  298.   const
  299.     TempString: YString = '';
  300.   var
  301.     TSindex : Byte;
  302.     VsOffset: Word;
  303.   begin
  304.     if VsPointer <> Nil then
  305.       begin
  306.         if (Yaxis > Rows) then Yaxis := Rows;
  307.         if (Xaxis > Columns) then Xaxis := Columns;
  308.  
  309.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  310.         Str(RealNum:Width:Decimals, TempString);
  311.  
  312.         if ((Length(TempString) + Yaxis) > Rows) then
  313.           TempString[0] := char((Rows + 1) - Yaxis);
  314.  
  315.         for TSindex := 0 to (Length(TempString) - 1) do
  316.           VsPointer^[VsOffset + (TSindex * Columns)] :=
  317.                        (Byte(TempString[(TSindex + 1)]) + (CAttr shl 8))
  318.       end
  319.   end;
  320.  
  321.   procedure WriteStringVs(VsPointer: VsPtr; InString: XString; Wrap: Boolean;
  322.                           Xaxis, Yaxis, CAttr: Byte);
  323.   var
  324.     ISindex : Byte;
  325.     VsOffset: Word;
  326.   begin
  327.     if VsPointer <> Nil then
  328.       begin
  329.         if (Yaxis > Rows) then Yaxis := Rows;
  330.  
  331.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  332.  
  333.         if (Yaxis = Rows) then Wrap := False;
  334.  
  335.         if not Wrap then
  336.           if ((Length(InString) + Xaxis) > Columns) then
  337.             InString[0] := char((Columns + 1) - Xaxis);
  338.  
  339.         for ISindex := 0 to (Length(InString) - 1) do
  340.           VsPointer^[VsOffset + ISindex] :=
  341.                          (Byte(InString[(ISindex + 1)]) + (CAttr shl 8))
  342.       end
  343.   end;
  344.  
  345.   procedure VWriteStringVs(VsPointer: VsPtr; InString: YString;
  346.                            Xaxis, Yaxis, CAttr: Byte);
  347.   var
  348.     IsIndex : Byte;
  349.     VsOffset: Word;
  350.   begin
  351.     if VsPointer <> Nil then
  352.       begin
  353.         if (Yaxis > Rows) then Yaxis := Rows;
  354.         if (Xaxis > Columns) then Xaxis := Columns;
  355.  
  356.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  357.  
  358.         if ((Length(InString) + Yaxis) > Rows) then
  359.           InString[0] := char((Rows + 1) - Yaxis);
  360.  
  361.         for IsIndex := 0 to (Length(InString) - 1) do
  362.           VsPointer^[VsOffset + (IsIndex * Columns)] :=
  363.                          (Byte(InString[(IsIndex + 1)]) + (CAttr shl 8));
  364.       end;
  365.   end;
  366.  
  367.   procedure ClrVScrWindow(VsPointer: VsPtr; LxAxis, RxAxis, TopYaxis,
  368.                           BotYaxis, CAttr: Byte);
  369.   var
  370.     VsIndex, LineSize, VsOffset: Word;
  371.   begin
  372.     if VsPointer <> Nil then
  373.       begin
  374.         VsOffset := (((TopYaxis - 1) * Columns) + LxAxis);
  375.         LineSize := (RxAxis - LxAxis) + 1;
  376.  
  377.         for VsIndex := 0 to (LineSize - 1) do
  378.           VsPointer^[VsOffset + VsIndex] := (32 + (CAttr shl 8));
  379.  
  380.         for VsIndex := 1 to (BotYaxis - TopYaxis) do
  381.           Move(VsPointer^[VsOffset], VsPointer^[VsOffset +
  382.                (VsIndex * Columns)], (LineSize * 2));
  383.       end;
  384.   end;
  385.  
  386.   procedure SaveToVs(VsPointer: VsPtr);
  387.   begin
  388.     if VsPointer <> Nil then
  389.       begin
  390.         if VsPointer <> Nil then
  391.           VsPointer^ := VideoAddress^
  392.       end;
  393.   end;
  394.  
  395.   procedure DisplayVs(VsPointer: VsPtr);
  396.   begin
  397.     if VsPointer <> Nil then
  398.       begin
  399.         if VsPointer <> Nil then
  400.           VideoAddress^ := VsPointer^
  401.       end;
  402.   end;
  403.  
  404.  
  405.   procedure SetVsXYAttr(VsPointer: VsPtr; AttrsToChange, Xaxis,
  406.                         Yaxis, CAttr: Byte);
  407.   var
  408.     AttrIndex: Byte;
  409.     VsOffset : Word;
  410.   begin
  411.     if VsPointer <> Nil then
  412.       begin
  413.         if (Yaxis > Rows) then Yaxis := Rows;
  414.  
  415.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  416.  
  417.         if (Yaxis = Rows) and ((AttrsToChange + Xaxis) > Columns) then
  418.           AttrsToChange := ((Columns + 1) - Xaxis);
  419.  
  420.         for AttrIndex := 0 to (AttrsToChange - 1) do
  421.           begin
  422.             VsPointer^[VsOffset + AttrIndex] :=
  423.               Lo(VsPointer^[VsOffset + AttrIndex]) + (CAttr shl 8);
  424.           end;
  425.       end;
  426.   end;
  427.  
  428.   procedure VSetVsXYAttr(VsPointer: VsPtr; AttrsToChange, Xaxis,
  429.                          Yaxis, CAttr: Byte);
  430.   var
  431.     AttrIndex: Byte;
  432.     VsOffset : Word;
  433.   begin
  434.     if VsPointer <> Nil then
  435.       begin
  436.         if (Yaxis > Rows) then Yaxis := Rows;
  437.         if (Xaxis > Columns) then Xaxis := Columns;
  438.  
  439.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  440.  
  441.         if ((AttrsToChange + Yaxis) > Rows) then
  442.           AttrsToChange := ((Rows + 1) - Yaxis);
  443.  
  444.         for AttrIndex := 0 to (AttrsToChange - 1) do
  445.           begin
  446.             VsPointer^[VsOffSet + (AttrIndex * Columns)] :=
  447.               Lo(VsPointer^[VsOffSet + (AttrIndex * Columns)]) +
  448.                                                          (CAttr shl 8);
  449.           end;
  450.       end;
  451.   end;
  452.  
  453.   procedure SetVsWindowAttr(VsPointer: VsPtr; LxAxis, RxAxis,
  454.                             TopYaxis, BotYaxis, CAttr: Byte);
  455.   var
  456.     LineSize, VsOffSet, VsIndex1, VsIndex2: Word;
  457.   begin
  458.     if VsPointer <> Nil then
  459.       begin
  460.         VsOffset := (((TopYaxis - 1) * Columns) + LxAxis);
  461.         LineSize := (RxAxis - LxAxis);
  462.  
  463.         for VsIndex1 := 0 to (BotYaxis - TopYaxis) do
  464.         begin
  465.           for VsIndex2 := 0 to LineSize do
  466.             VsPointer^[VsOffset + VsIndex2] :=
  467.                   Lo(VsPointer^[VsOffset + VsIndex2]) + (CAttr shl 8);
  468.           Inc(VsOffset,  Columns);
  469.         end;
  470.       end;
  471.   end;
  472.  
  473.   procedure SetVsAttr(VsPointer: VsPtr; CAttr: Byte);
  474.   type
  475.     VsAttrArray =  Array[1..VsByteSize] of Byte;
  476.   var
  477.     VsAaPtr      : ^VsAttrArray;
  478.     AttrIndex    : Word;
  479.   begin
  480.     if VsPointer <> Nil then
  481.     begin
  482.       VsAaPtr := Addr(VsPointer^);
  483.       for AttrIndex := 1 to VsWordSize do
  484.         VsAaPtr^[AttrIndex * 2] := CAttr
  485.     end
  486.  end;
  487.  
  488.   procedure SaveVsToDisk(VsPointer: VsPtr; FileName: FnString;
  489.                          ScreenNumber: Word);
  490.   var
  491.     ScreenFile: file of VirtualScreenArray;
  492.   begin
  493.     if VsPointer <> Nil then
  494.       begin
  495.         Assign(ScreenFile, FileName); {$I-} ReSet(ScreenFile); {$I+}
  496.         if IOResult <> 0 then
  497.           begin
  498.             {$I-} ReWrite(ScreenFile); {I+}
  499.             if IoResult <> 0 then Exit;
  500.           end;
  501.         Seek(ScreenFile, (ScreenNumber - 1));
  502.         Write(ScreenFile, VsPointer^);
  503.         Close(ScreenFile)
  504.       end
  505.   end;
  506.  
  507.   procedure LoadVsFromDisk(VsPointer: VsPtr; FileName: FnString;
  508.                            ScreenNumber: Word);
  509.   var
  510.     ScreenFile: file of VirtualScreenArray;
  511.   begin
  512.     if VsPointer <> Nil then
  513.       begin
  514.         Assign(ScreenFile, FileName); {$I-} ReSet(ScreenFile); {$I+}
  515.         if IOResult <> 0 then Exit;
  516.         Seek(ScreenFile, (ScreenNumber - 1));
  517.         Read(ScreenFile, VsPointer^);
  518.         Close(ScreenFile)
  519.      end
  520.   end;
  521.  
  522.   function GetVsXYAttr(VsPointer: VsPtr; Xaxis, Yaxis: Byte): Byte;
  523.   var
  524.     VsOffset: Word;
  525.   begin
  526.     if VsPointer <> Nil then
  527.       begin
  528.         if (Yaxis > Rows) then Yaxis := Rows;
  529.         if (Xaxis > Columns) then Xaxis := Columns;
  530.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  531.         GetVsXYAttr := Hi(VsPointer^[VsOffset]);
  532.       end
  533.   end;
  534.  
  535.   function GetVsXYchar(VsPointer: VsPtr; Xaxis, Yaxis: Byte): Char;
  536.   var
  537.     VsOffset: Word;
  538.   begin
  539.     if VsPointer <> Nil then
  540.       begin
  541.         if (Yaxis > Rows) then Yaxis := Rows;
  542.         if (Xaxis > Columns) then Xaxis := Columns;
  543.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  544.         GetVsXYchar := char(Lo(VsPointer^[VsOffset]));
  545.       end
  546.   end;
  547.  
  548.   function GetVsXYString(VsPointer: VsPtr; Xaxis, Yaxis,
  549.                          StringSize: Byte): String;
  550.   const
  551.     TempString: XString = '';
  552.   var
  553.     TsIndex, VsOffset: Word;
  554.   begin
  555.     if VsPointer <> Nil then
  556.       begin
  557.         if (Yaxis > Rows) then Yaxis := Rows;
  558.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  559.         if (Yaxis = Rows) and ((Xaxis + StringSize) > Columns) then
  560.           TempString[0] := char((Columns + 1) - Xaxis)
  561.         else
  562.           TempString[0] := char(StringSize);
  563.         for TsIndex := 0 to (Length(TempString) - 1) do
  564.           TempString[(TsIndex + 1)] :=
  565.                                Char(Lo(VsPointer^[VsOffset + TsIndex]));
  566.         GetVsXYString := TempString;
  567.       end
  568.   end;
  569.  
  570.   function VGetVsXYString(VsPointer: VsPtr; Xaxis, Yaxis,
  571.                           StringSize: Byte): String;
  572.   const
  573.     TempString: YString = '';
  574.   var
  575.     TsIndex,
  576.     VsOffset: Word;
  577.   begin
  578.     if VsPointer <> Nil then
  579.       begin
  580.         if (Yaxis > Rows) then Yaxis := Rows;
  581.         if (Xaxis > Columns) then Xaxis := Columns;
  582.         VsOffset := (((Yaxis - 1) * Columns) + Xaxis);
  583.         if ((StringSize + Yaxis) > Rows) then
  584.           TempString[0] := char((Rows + 1) - Yaxis)
  585.         else
  586.           TempString[0] := char(StringSize);
  587.         for TsIndex := 0 to (Length(TempString) - 1) do
  588.           TempString[(TsIndex + 1)] := char(Lo(VsPointer^[VsOffset +
  589.                                              (TsIndex * Columns)]));
  590.         VGetVsXYString := TempString;
  591.       end
  592.   end;
  593.  
  594.   procedure ScrollVs(VsPointer1: VsPtr; VsPointer2: VsPtr;
  595.                      Direction : ScrollTypes; ScrollNum : Word);
  596.   var
  597.     S1, S2: Word;
  598.   begin
  599.     if (VsPointer1 <> Nil)
  600.       and (VsPointer2 <> Nil)
  601.         and (VsPointer1 <> VsPointer2) then
  602.       begin
  603.         case Direction of
  604.           Up: Move(VsPointer1^[(ScrollNum * Columns) + 1],
  605.                     VsPointer2^[1], (VsByteSize - (ScrollNum *
  606.                     Columns * 2)));
  607.           Down: Move(VsPointer1^[1],
  608.                       VsPointer2^[(ScrollNum * Columns) + 1],
  609.                       (VsByteSize - (ScrollNum * Columns * 2)));
  610.           Right: for S1 := 0 to (Rows - 1) do
  611.                     Move(VsPointer1^[1 + (S1 * Columns)],
  612.                           VsPointer2^[1 + (S1 * Columns) + ScrollNum],
  613.                           ((Columns - ScrollNum) * 2));
  614.           Left: for S1 := 0 to (Rows - 1) do
  615.                    Move(VsPointer1^[1 + (S1 * Columns) + ScrollNum],
  616.                           VsPointer2^[1 + (S1 * Columns)],
  617.                           ((Columns - ScrollNum) * 2));
  618.           FlipX: for S1 := 0 to (Rows - 1) do
  619.                     for S2 := 0 to (Columns - 1) do
  620.                       VsPointer2^[(Columns - S2) + (S1 * Columns)] :=
  621.                         VsPointer1^[(S2 + 1) + (S1 * Columns)];
  622.           FlipY: for S1 := 0 to (Rows - 1) do
  623.                     Move(VsPointer1^[1 + (S1 * Columns)],
  624.                          VsPointer2^[1 + ((Rows - (S1 + 1))
  625.                          * Columns)], (Columns * 2));
  626.         end;       (* case Direction of...                           *)
  627.       end;
  628.   end;
  629.  
  630.   procedure MoveVsChar(VsPointer1: VsPtr; Xaxis1, Yaxis1: Byte;
  631.                        VsPointer2: VsPtr; Xaxis2, Yaxis2: Byte);
  632.   var
  633.     VsOffset1, VsOffset2: Word;
  634.   begin
  635.     if (VsPointer1 <> Nil)
  636.       and (VsPointer2 <> Nil)
  637.         and (VsPointer1 <> VsPointer2) then
  638.       begin
  639.         if (Yaxis1 > Rows) then Yaxis1 := Rows;
  640.         if (Xaxis1 > Columns) then Xaxis1 := Columns;
  641.         if (Yaxis2 > Rows) then Yaxis2 := Rows;
  642.         if (Xaxis2 > Columns) then Xaxis2 := Columns;
  643.  
  644.         VsOffset1 := (((Yaxis1 - 1) * Columns) + Xaxis1);
  645.         VsOffset2 := (((Yaxis2 - 1) * Columns) + Xaxis2);
  646.  
  647.         VsPointer2^[VsOffset2] := VsPointer1^[VsOffset1];
  648.       end
  649.   end;
  650.  
  651.   procedure MoveVsBlock(VsPointer1: VsPtr; Xaxis1, Yaxis1: Byte;
  652.                         VsPointer2: VsPtr; Xaxis2, Yaxis2: Byte;
  653.                         CharsToMove: Word);
  654.   var
  655.     VsOffset1, VsOffset2: Word;
  656.   begin
  657.     if (VsPointer1 <> Nil)
  658.       and (VsPointer2 <> Nil)
  659.         and (VsPointer1 <> VsPointer2) then
  660.       begin
  661.         if (Yaxis1 > Rows) then Yaxis1 := Rows;
  662.         if (Yaxis2 > Rows) then Yaxis2 := Rows;
  663.         if (Xaxis1 > Columns) then Xaxis1 := Columns;
  664.         if (Xaxis2 > Columns) then Xaxis2 := Columns;
  665.  
  666.         VsOffset1 := (((Yaxis1 - 1) * Columns) + Xaxis1);
  667.         VsOffset2 := (((Yaxis2 - 1) * Columns) + Xaxis2);
  668.  
  669.         if VsOffset1 > VsOffset2 then
  670.         begin
  671.           if CharsToMove > (VsWordSize - VsOffSet2) then
  672.             CharsToMove := (VsWordSize - VsOffSet2);
  673.         end
  674.         else
  675.           begin
  676.             if CharsToMove > (VsWordSize - VsOffSet1) then
  677.               CharsToMove := (VsWordSize - VsOffSet1);
  678.           end;
  679.         Move(VsPointer1^[VsOffset1], VsPointer2^[VsOffset2],
  680.                                                      (CharsToMove * 2));
  681.       end;
  682.   end;
  683.  
  684.   procedure MoveVsWindowBlock(VsPointer1: VsPtr; LxAxis1, RxAxis1,
  685.                               TopYaxis1, BotYaxis1: Byte; VsPointer2: VsPtr;
  686.                               LxAxis2, RxAxis2, TopYaxis2, BotYaxis2: Byte);
  687.   var
  688.     LineSize, RowIndex, VsOffset1, VsOffset2, MoveIndex: Word;
  689.   begin
  690.     if (VsPointer1 <> Nil)
  691.       and (VsPointer2 <> Nil)
  692.         and (VsPointer1 <> VsPointer2) then
  693.       begin
  694.         if (BotYaxis1 > Rows) then BotYaxis1 := Rows;
  695.         if (BotYaxis2 > Rows) then BotYaxis2 := Rows;
  696.         if (RxAxis1 > Columns) then RxAxis1 := Columns;
  697.         if (RxAxis2 > Columns) then RxAxis2 := Columns;
  698.  
  699.         VsOffset1 := (((TopYaxis1 - 1) * Columns) + LxAxis1);
  700.         VsOffset2 := (((TopYaxis2 - 1) * Columns) + LxAxis2);
  701.  
  702.         if (RxAxis1 - LxAxis1) > (RxAxis2 - LxAxis2) then
  703.           LineSize := (RxAxis2 - LxAxis2)
  704.         else
  705.           LineSize := (RxAxis1 - LxAxis1);
  706.         if (BotYaxis1 - TopYaxis1) > (BotYaxis2 - TopYaxis2) then
  707.           RowIndex := (BotYaxis2 - TopYaxis2)
  708.         else
  709.           RowIndex := (BotYaxis1 - TopYaxis1);
  710.         for MoveIndex := 0 to RowIndex do
  711.           Move(VsPointer1^[VsOffset1 + (MoveIndex * Columns)],
  712.                VsPointer2^[VsOffset2 + (MoveIndex * Columns)],
  713.                                                         (LineSize * 2));
  714.       end;
  715.   end;
  716.  
  717. {$F-}
  718.                    (* Procedure to set the initial VideoAddress     *)
  719.                    (* Determines either Color or B&W mode.          *)
  720.   procedure SetVideoAddress;
  721.   begin
  722.     if ((Mem[$0000:$0410] and $30) <> $30) then
  723.       begin
  724.         VideoAddress := Ptr($B800, $0000);
  725.         MainScreen := Ptr($B800, $0000);
  726.         ColorMode := true
  727.       end
  728.     else
  729.       begin
  730.         VideoAddress := Ptr($B000, $0000);
  731.         MainScreen := Ptr($B000, $0000);
  732.         ColorMode := false
  733.       end;
  734.   end;
  735.  
  736.                    (* Procedure initialize/re-initialize the        *)
  737.                    (* VScreen Write.                                 *)
  738.   procedure ReInitVsWrite;
  739.   begin
  740.     SetVideoAddress;
  741.   end;
  742.  
  743. begin
  744.   SetVideoAddress  (* Initialize VideoAddress                       *)
  745. end.